Interactive Reporting Dashboards in Shiny

Laying the groundwork for interactive reporting & dashboards…

1. ggplot2 and gridExtra

library(ggplot2)
library(gridExtra)

Attaching package: ‘gridExtra’

The following object is masked from ‘package:dplyr’:

    combine

data(anscombe)

sapply(1:4, function(x) cor(anscombe[, x], anscombe[, x+4]))

[1] 0.8164205 0.8162365 0.8162867 0.8165214

sapply(5:8, function(x) var(anscombe[, x]))

[1] 4.127269 4.127629 4.122620 4.123249

lm(y1 ~ x1, data = anscombe)

Call:
lm(formula = y1 ~ x1, data = anscombe)

Coefficients:
(Intercept)           x1  
     3.0001       0.5001  

p1 <- ggplot(anscombe) + geom_point(aes(x1, y1), color = "darkorange", size = 3) + theme_bw() + scale_x_continuous(breaks = seq(0, 20, 2)) + scale_y_continuous(breaks = seq(0, 12, 2)) + geom_abline(intercept = 3, slope = 0.5, color = "cornflowerblue") + expand_limits(x = 0, y = 0) + labs(title = "dataset 1")
p2 <- ggplot(anscombe) + geom_point(aes(x2, y2), color = "darkorange", size = 3) + theme_bw() + scale_x_continuous(breaks = seq(0, 20, 2)) + scale_y_continuous(breaks = seq(0, 12, 2)) + geom_abline(intercept = 3, slope = 0.5, color = "cornflowerblue") + expand_limits(x = 0, y = 0) + labs(title = "dataset 2")
p3 <- ggplot(anscombe) + geom_point(aes(x3, y3), color = "darkorange", size = 3) + theme_bw() + scale_x_continuous(breaks = seq(0, 20, 2)) + scale_y_continuous(breaks = seq(0, 12, 2)) + geom_abline(intercept = 3, slope = 0.5, color = "cornflowerblue") + expand_limits(x = 0, y = 0) + labs(title = "dataset 3")
p4 <- ggplot(anscombe) + geom_point(aes(x4, y4), color = "darkorange", size = 3) + theme_bw() + scale_x_continuous(breaks = seq(0, 20, 2)) + scale_y_continuous(breaks = seq(0, 12, 2)) + geom_abline(intercept = 3, slope = 0.5, color = "cornflowerblue") + expand_limits(x = 0, y = 0) + labs(title = "dataset 4")

grid.arrange(p1, p2, p3, p4, top = "Anscombe's Quartet")

library(ggplot2)

p <- ggplot(data = diamonds, aes(x = cut, fill = clarity)) +
            geom_bar(position = "dodge")
p

2.B Plotly

http://www.htmlwidgets.org/showcase_plotly.html

https://plot.ly/r/dashboard/

https://plot.ly/r/shiny-tutorial/

library(plotly)

Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

ggplotly(p)

d <- diamonds[sample(nrow(diamonds), 500), ]
plot_ly(d, x = d$carat, y = d$price, 
        text = paste("Clarity: ", d$clarity),
        mode = "markers", color = d$carat, size = d$carat)

No trace type specified:
  Based on info supplied, a 'scatter' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#scatter
`arrange_()` is deprecated as of dplyr 0.7.0.
Please use `arrange()` instead.
See vignette('programming') for more help
This warning is displayed once every 8 hours.
Call `lifecycle::last_warnings()` to see where this warning was generated.`line.width` does not currently support multiple values.No trace type specified:
  Based on info supplied, a 'scatter' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#scatter
`line.width` does not currently support multiple values.

2. HTML Widgets

http://www.htmlwidgets.org

2.A Dygraphs

http://www.htmlwidgets.org/showcase_dygraphs.html

Basic plot example:

## standard graphics device
library(stats)
plot(nhtemp, main = "nhtemp data", ylab = "Mean annual temp. in F)")

## using dygraphs
library(dygraphs)
fig <- dygraph(nhtemp, main = "New Haven Temperatures")
fig <- dyAxis(fig, "y", label = "Temp (F)", valueRange = c(40, 60))
fig <- dyOptions(fig, axisLineWidth = 1.5, fillGraph = TRUE, drawGrid = FALSE)
fig

dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dySeries("V1", label = "Temperature (F)") %>%
  dyLegend(show = "always", hideOnMouseOut = FALSE)

NA

dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dyRangeSelector()

dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dyRangeSelector(dateWindow = c("1920-01-01", "1960-01-01"))

dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dyRangeSelector(height = 20, strokeColor = "")

#Shaded Regions
dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dyShading(from = "1920-1-1", to = "1930-1-1") %>%
  dyShading(from = "1940-1-1", to = "1950-1-1")

dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dySeries(label = "Temp (F)", color = "black") %>%
  dyShading(from = "1920-1-1", to = "1930-1-1", color = "#FFE6E6") %>%
  dyShading(from = "1940-1-1", to = "1950-1-1", color = "#CCEBD6")

library(quantmod)
library(dygraphs)

prices <- round(getSymbols("MSFT", from = "2014-06-01", auto.assign = FALSE), 2)



ret = ROC(prices[, 4])
mn = mean(ret, na.rm = TRUE)
std = sd(ret, na.rm = TRUE)
dygraph(ret, main = "Microsoft Share Price") %>% 
  dySeries("MSFT.Close", label = "MSFT") %>%
  dyShading(from = mn - std, to = mn + std, axis = "y")

NA
NA

prices <- round(getSymbols("MSFT", from = "2014-06-01", auto.assign = FALSE), 2)
dygraph(prices[, 4], main = "Microsoft Share Price") %>% 
  dySeries("MSFT.Close", label = "MSFT") %>%
  dyLimit(as.numeric(prices[1, 4]), color = "red")

getSymbols(c("MSFT", "HPQ"), from = "2014-06-01", auto.assign=TRUE)

[1] "MSFT" "HPQ" 

stocks <- cbind(MSFT[,2:4], HPQ[,2:4])
dygraph(stocks, main = "Microsoft and HP Share Prices") %>% 
  dySeries(c("MSFT.Low", "MSFT.Close", "MSFT.High"), label = "MSFT") %>%
  dySeries(c("HPQ.Low", "HPQ.Close", "HPQ.High"), label = "HPQ")

2.C rbokeh

http://www.htmlwidgets.org/showcase_rbokeh.html

library(rbokeh)

Registered S3 method overwritten by 'pryr':
  method      from
  print.bytes Rcpp

figure() %>%
  ly_points(Sepal.Length, Sepal.Width, data = iris,
    color = Species, glyph = Species,
    hover = list(Sepal.Length, Sepal.Width))

figure(width = NULL, height = NULL, legend_location = "top_left") %>%
  ly_quantile(Sepal.Length, group = Species, data = iris)

figure(width = NULL, height = NULL) %>%
  ly_points(Sepal.Length, Sepal.Width, data = iris,
    color = Petal.Width)

tools <- c("pan", "wheel_zoom", "box_zoom", "box_select", "reset")
nms <- expand.grid(names(iris)[1:4], rev(names(iris)[1:4]), stringsAsFactors = FALSE)
splom_list <- vector("list", 16)
for(ii in seq_len(nrow(nms))) {
  splom_list[[ii]] <- figure(width = 200, height = 200, tools = tools,
    xlab = nms$Var1[ii], ylab = nms$Var2[ii]) %>%
    ly_points(nms$Var1[ii], nms$Var2[ii], data = iris,
      color = Species, size = 5, legend = FALSE)
}
grid_plot(splom_list, ncol = 4, same_axes = TRUE, link_data = TRUE)

2.4 DT

http://www.htmlwidgets.org/showcase_datatables.html

library(DT)
datatable(iris, options = list(pageLength = 5))

6. Crosstalk

http://rstudio.github.io/crosstalk/index.html

http://rstudio.github.io/crosstalk/shiny.html

Examples: